Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-02/grsear20.zip/GRINITUN.PAS

Pascal/Delphi Source File | 1993-01-04 | 14KB | 404 lines

unit grinitun;
{ Author:
    7/17/88    Michael Shunfenthal  Compuserve ID [76320,122]

PROGRAM FUNCTION
Determine the adapter type, and search for the driver file.  For more
info, refer to the file GRINIT.DOC.
}

interface
uses dos, crt, graph;

type debugrange = 0..2;
    function grsearch
          (environvar : string; var GraphDriver : integer;
          var dirstring : string; grdebug : debugrange) : boolean;

{    Explanation:
    function true: driver found and adapter initialized
             false: an error prevents graphics initialization
    environvar:  contains the desired environment variable name to be
                 examined for the list of directories in the format of the
                 path variable.  if null, ('') PATH is the default.
    GraphDriver: graphics driver found by DetectGraph
    dirstring:   contains the path to the required driver file
    grdebug: 0 = no display.  use only function value to indicate status
             1 = display errors only
             2 = verbose: display errors, list the environment and
                  the directories in the specified environment variable
 }
implementation

function grsearch;

const
   { max number of directories in the path }
      MaxDirectories = 20;
   { max length of each directory string }
      MaxDirLength = 64;
   { max space searched for environment }
      MaxEnvironSpace = 32000;
   { maximum length of the environment variable }
      MaxVarLength = 1000;

type
   bytepatharray = Array [1..MaxDirectories, 1..MaxDirLength] of byte;
   maxdirtype = 0..MaxDirectories;

var
   GraphMode   : integer;
   graphstatus              : integer;
   bgifile                  : string [8];
   varfound                 : boolean;

procedure GraphicsDetermine;
{ detect and return the adapter type, then
   define the bgi file to be found }

begin
   DetectGraph(GraphDriver, GraphMode );
   case GraphDriver of          { set the BGI file to be found }
      Reserved,
      CGA      : bgifile := 'CGA';
      EGA, EGA64, EGAMono,
      MCGA, VGA: bgifile := 'EGAVGA';
      Hercmono : bgifile := 'HERC';
      ATT400   : bgifile := 'ATT';
      PC3270   : bgifile := 'PC3270';
   end;
   graphstatus := GraphResult;
   if graphstatus <> grOk
      then      { test result of graphics operation }
         begin
            if (grdebug=1) or (grdebug=2)
               then
               writeln('DetectGraph error: ', GraphErrorMsg(GraphDriver));
            Halt(1);
         end;
 end; { GraphicsDetermine }

 procedure SearchEnvironment ( var dircount : maxdirtype;
                              var dirlist : bytepatharray );
 { read the environment and extract the directory list }
 var
     Segment        : Integer;        { the two parts of an address }
     offset,                          { index into environment space }
     { offset where the variable begins }
     offsetvarstart : 0 .. MaxEnvironSpace;

procedure ReadEnvironment;
{ read the environment area, searching for variables delimited by a null }

function locatevariable : boolean;
{ search for the specified variable, or 'PATH'}

label 1000, 2000;

var
   index : integer;

begin
 {prepare passed parameter for use: substitute 'PATH' if null, or
 trim trailing spaces and convert to uppercase }
if length( environvar)>0
   then
      for index := 1 to length (environvar) do
         if environvar[index]=' '
            then
               begin
                  environvar := copy(environvar,1,length(environvar)-1);
                  goto 1000
               end
            else
               environvar[index] := upcase( environvar[index])
   else
      environvar := 'PATH';
{ compare each character in the passed variable to the character
in the environment }
1000: for index := 1 to length (environvar) do
   if Mem[Segment:offset-1+index] <> ord( environvar[index])
         then goto 2000;
   { mark one more than the first character after the variable to
   skip over the '=' sign }
   offsetvarstart:=offset + length (environvar) +1;
   locatevariable := true;
   exit;
   { mismatch: error exit }
   2000: locatevariable := false;
end; { locatevariable }


Begin { ReadEnvironment }
   offset := 0;              { set initial offsets }
   if grdebug=2
      then
         begin
            ClrScr;
            writeln('The environment variables: ')
         end;
   While (offset < MaxEnvironSpace) do
      begin
         { call locatevariable to see if it is the first variable
         in the environment }
         if offset = 0
            then
               varfound := locatevariable;
         if Mem[Segment:offset] = 0
            then
               begin
                  if Mem[Segment:offset+1] = 0
                     then
                        begin
                        { two nulls in a row indicate the end of the
                        environment }
                           if grdebug=2
                              then
                               begin
                                writeln;
                                writeln('The DOS environment is ',offset,
                                  ' bytes long.', environvar,
                                  ' located at offset: ', offsetvarstart)
                               end;
                           exit
                        end
                     else
                        { a single null indicates the end of one variable,
                        so the call to locatevariable will not find one
                        as part of another call only if the variable has
                        not already been found}
                        begin
                           offset := offset + 1;
                           if not varfound then varfound := locatevariable;
                           offset := offset - 1;
                           if grdebug=2
                              then
                               writeln
                        end
               end
            else  { not a null }
               begin
                  if grdebug=2
                     then
                        write(chr(Mem[Segment:offset]));
               end;
         offset := offset + 1;
   end;  { end while loop }
End;  { ReadEnvironment }

Procedure StorePath;
{ search for each directory delimited by a ';', store it in an array
  and filter non-allowed characters }

var
   dirndx : maxdirtype;   { directory counter }
   pc  : 0..MaxDirLength; { when searching: character-in-path counter }
   offsetvarctr : integer; { counter into the the variable's list of dirs }

Begin
   pc  := 0;
   dircount := 1;
   offsetvarctr := offsetvarstart;
   While offsetvarctr< offsetvarstart+MaxVarLength do
      begin
         if Mem[Segment:offsetvarctr]=0
            then
                { null found, so search is complete force exit from loop }
               offsetvarctr := offsetvarstart+MaxVarLength + 1
            else
               if Mem[Segment:offsetvarctr] in
                  { are they allowable chars?  }
                  [33..41,                  { punctuation }
                  44..59,  61,      { punctuation, numbers, ';' }
                  64..90, 92,       { uppercase alphabetics, '\' }
                  97..122]          { lowercase alphabetics }
                    then
                     if Mem[Segment:offsetvarctr]=59
                        then   { the PATH delim }
                           begin
                              { end of one subdirectory, so
                              reset char count, increment dircount }
                              dircount := dircount + 1;
                              pc := 0;
                              if dircount >= MaxDirectories
                               then
                                begin
                                 if (grdebug=1) or (grdebug=2)
                                  then
                                   writeln(
                                 'Too many Paths encountered... exiting'
                                   );
                                 Halt(1)
                                 { to DOS with ErrorLevel set to 1 }
                                end;
                           end
                        else
                           begin
                              { save the path character in an array }
                              pc := pc+1;
                              dirlist[dircount][pc] := Mem[Segment:
                                                       offsetvarctr];
                           end;
         offsetvarctr := offsetvarctr + 1;
      end;
end; { StorePath }

Procedure ListPath;
{ display each directory in the path }

var
   dirndx : maxdirtype;   { directory counter }
   pc : integer;        { count characters in the array }

begin
   writeln;
   writeln('Number of directories: ', dircount,
            '.  The list of directories:');
   If dircount >= 1
      then
         For dirndx:=1 to dircount do
            begin
               pc := 1;
               While (pc < MaxDirLength) and
                 ( dirlist[dirndx][pc]<>0) do
                  begin
                     { it is a printable char }
                     write(chr(dirlist[dirndx][pc]));
                     pc := pc + 1
                  end;
                  writeln; { a new line }
            end { dirndx loop }
         else
                  writeln('No PATH variable in the environment');
end;  { ListPath }

Begin {searchenvironment}
   {segment where the environment starts }
   Segment := MemW[PrefixSeg:$2C];
   ReadEnvironment;
   if varfound
      then
         begin
            StorePath;
            if grdebug=2
               then
               ListPath;
         end
      else
         if (grdebug=1) or (grdebug=2)
            then
               writeln ('Environment variable: ', environvar,' not found');
End; {searchenvironment}

procedure BgiFind; { search for the given bgifile }

label
   1000;

var
   listdirbyte : bytepatharray;
   maxdirs, countdirs : maxdirtype;
   countbyte : integer;
   filerecord : searchrec;

begin { bgifind }
{ first search for bgi file in the default directory.
  if not found, continue the search by sequentially testing each
  directory in array listdirbyte }
   findfirst ( bgifile+'.bgi', anyfile, filerecord);
   if doserror = 0
      then
         begin
            if grdebug=2
               then
                  writeln ( 'Found in default directory: ', bgifile +
                           '.bgi');
            exit;
         end
      else
         begin
         { initialize the array before using it }
            for maxdirs := 1 to MaxDirectories do
            for countbyte := 1 to MaxDirLength do
               listdirbyte[maxdirs,countbyte] := 0;
            searchenvironment (maxdirs, listdirbyte);
            { convert the byte array into an input for findfirst }
            if varfound
               then
                  for countdirs := 1 to maxdirs do
                     begin
                        dirstring := '';
                        for countbyte := 1 to MaxDirLength do
                           begin
               { starting with the left end of the byte array, stuff the
               character equivalent into the string variable dirstring
               until the first null is reached.  At that byte, substitute
               a '\' if the last character wasn't already a '\' }
                              if listdirbyte[countdirs, countbyte] <> 0
                               then
                                dirstring := dirstring +
                                  chr (listdirbyte[countdirs, countbyte])
                               else {null byte: end of directory path }
                                if copy (dirstring, length (
                                   dirstring), 1)<>'\'
                                 then
                                  begin
                                   dirstring := dirstring + '\';
                                   goto 1000;
                                  end;
                           end;
                        1000: findfirst ( dirstring+bgifile+'.bgi',
                                            anyfile, filerecord);
                        if doserror = 0
                           then
                              begin
                               if grdebug=2
                                then
                                 writeln ( 'Found: ', dirstring+
                                          bgifile+'.bgi');
                               exit;
                              end
                           else
                              if grdebug=2
                               then
                                writeln ( 'Did not find: ',
                                         dirstring+bgifile+'.bgi',
                                         ' Dos error: ', doserror );
                     end;
         end; { look in default directory }
 end; { bgifind }

begin {main procedure}
   GraphicsDetermine;
   bgifind;
   if varfound
   then
   begin
   { wait to allow observing the screen }
   if grdebug=2
      then
         begin
            writeln('Press <return>');
            readln
         end;
   InitGraph (Graphdriver, Graphmode, dirstring);
   graphstatus := GraphResult;
   if graphstatus <> grOk
      then
         begin
            if (grdebug=1) or (grdebug=2)
               then
               writeln( 'InitGraph error: ', GraphErrorMsg(GraphDriver));
               grsearch := false;
         end
      else
         grsearch := true;
   end
   else
      grsearch := false;

end; {main procedure}
begin
   {initialization}
end.